;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of ICCLE2.
;
; ICCLE2 is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; ICCLE2 is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with ICCLE2.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun tables (l &key (n 10) (ranker "~20,10f") (4class   #'num->bore)
	                                       (4others  #'num->ewd))
  (let* ((headers (list2headers (first l)))
         (data    (mapcar #'copy-list (rest l)))
         (rows    (length data))
         (cols    (length headers)))
       (when (< 50 rows)
	(setf n 3))
     (dolist (row data)
        (mapc #'sniff headers row))
      (mapc #'taste headers)
      (setf data 
	    (discretize-rows headers rows 4class 4others))
      (setf (last1 headers) 
	    (numeric2Discrete (last1 headers)))
      (mapcar #'(lambda table (headers) (folds data)))))

(defun table (headers fold)
      (dolist (row data)
        (let ((class (last1 row)))
	  (cross-index-row row headers class)))
      (make-table :headers (make-array `(,cols) 
                                :initial-contents headers)
                  :egs    (make-array `(,rows ,cols) 
                                :initial-contents data))))

(defmethod sniff ((n numeric) x)
  (push x (numeric-all n))
  (setf (numeric-max n) (max (numeric-max n) x)
        (numeric-min n) (min (numeric-min n) x))
  (incf (numeric-sum   n) x)
  (incf (numeric-sumsq n) (* x x))
  (incf (numeric-n n)))

(defmethod sniff ((d discrete) x)
  (incf (gethash x (discrete-uniques d) 0)))

(defmethod taste ((n numeric))
  (let* ((best       (numeric-best n))
         (nums       (numeric-all  n))
         (sorted     (sort nums #'<))
         (best2      (if (< best 0) (* -1 best) (- 1  best)))
         (best-pos   (round (* (length sorted) best2)))
         (best-val   (nth best-pos sorted)))
    (setf (numeric-best-num n) best-val
          (numeric-all      n) sorted)))
   
(defmethod taste ((d discrete))
  (setf (discrete-ranks d)
        (keys2sorted-alist (discrete-uniques d)
                           (wm-num-sorter *w*))))

(defun cross-index-row (row headers class)
  (mapc #'(lambda (cell header class)
	    (cross-index-cell header cell class))
	row headers))

(defmethod cross-index-cell ((d discrete) x class)
   (incf (gethash x (discrete-uniques d) 0))
   (incf (gethash `(,class ,x) (discrete-counts d) 0)))
